home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_2 / dieroll < prev    next >
Text File  |  1995-03-31  |  2KB  |  130 lines
  1. %%HP: T(3)A(D)F(.); 
  2. DIR 
  3.   DC 
  4.     \<< 1 3 
  5.       START DEPTH 
  6. DUP 
  7.         IF 
  8.         THEN ROLL 
  9.         END DROP 
  10.       NEXT DIE TYPE 
  11. 6 
  12.       IF == 
  13.       THEN DICE 
  14.       ELSE DIE SIZE 
  15. 4 
  16.         IF == 
  17.         THEN XDIE 
  18.         ELSE DICE 
  19.         END 
  20.       END 
  21.     \>> 
  22.   DICE 
  23.     \<< 5 
  24.       IF FC? 
  25.       THEN CL\GS 
  26.       END DEPTH DUP 
  27.       IF NOT 
  28.       THEN DIE 
  29.         IFERR LIST\-> 
  30. DROP 
  31.         THEN 6 2 0 
  32.         END 
  33.       ELSE \->LIST 
  34. CHK 
  35.       END \-> c d e 
  36.       \<< CLEAR 1 d 
  37.         START c 
  38. RDMZR \GS+ 
  39.         NEXT RCL\GS 
  40. ARRY\-> DROP d \->LIST 
  41. e TOT e + 5 
  42.         IF FC? 
  43.         THEN '\GSDAT' 
  44. PURGE 
  45.         END 
  46.       \>> 
  47.     \>> 
  48.   XDIE 
  49.     \<< DEPTH 
  50.       IF NOT 
  51.       THEN 
  52.         IFERR DIE 
  53. LIST\-> 
  54.         THEN 
  55. "ERROR- 
  56. NO ENTRY" 
  57. CLLCD 1 DISP 1200 
  58. .4 BEEP 1400 .4 
  59. BEEP 4 WAIT KILL 
  60.         ELSE 4 
  61.           IF \=/ 
  62.           THEN DICE 
  63. KILL 
  64.           END 
  65.         END 
  66.       ELSE DEPTH 1 
  67.         IF == 
  68.         THEN DIE 
  69. SIZE 4 
  70.           IF == 
  71.           THEN 
  72. 'DIE' SWAP 4 SWAP 
  73. PUT DIE LIST\-> DROP 
  74.           END 
  75.         END 
  76.       END ASK \-> a 
  77.       \<< 5 SF CL\GS 1 
  78. a 
  79.         START DICE 
  80. CLEAR 
  81.         NEXT 5 CF ' 
  82. DIE(2)' EVAL a SWAP 
  83. 2 \->LIST '\GSDAT' SWAP 
  84. RDM \GSDAT '\GSDAT' TRN 
  85. TOT 'DIE(3)' EVAL { 
  86. a } SWAP CON + 4 
  87.         IF FS? 
  88.         THEN MIN\GS - 
  89.         END ARRY\-> 
  90. DROP a \->LIST DIE a 
  91. + 'DIE' STO 'DIE(3) 
  92. ' EVAL SWAP '\GSDAT' 
  93. PURGE 2 PICK 
  94.         IF NOT 
  95.         THEN 2 ROLL 
  96. DROP 
  97.         END 
  98.       \>> 
  99.     \>> 
  100.   RDMZR 
  101.     \<< \-> a 
  102.       \<< RAND a * IP 
  103. 1 + 
  104.       \>> 
  105.     \>> 
  106.   DIE { 6 3 0 5 } 
  107.   CHK 
  108.     \<< \-> a 
  109.       \<< CLEAR a { { 
  110. 1 0 } { 0 } { } } a 
  111. SIZE 
  112.         IFERR GET 
  113.         THEN DROP a 
  114. 1 3 SUB { } 
  115.         END + DUP 
  116. 'DIE' STO LIST\-> 
  117. DROP 
  118.       \>> 
  119.     \>> 
  120.   ASK 
  121.     \<< { { "YES" 
  122.       \<< 4 SF CONT 
  123.       \>> } { "NO" 
  124.       \<< 4 CF CONT 
  125.       \>> } } TMENU 
  126. "Drop lowest roll?" 
  127. PROMPT 0 MENU 
  128.     \>> 
  129. END 
  130.